perm filename QPRN.SAI[1,BGB] blob
sn#015998 filedate 1972-12-06 generic text, type T, neo UTF8
00100 BEGIN "QPRN"
00200 REQUIRE "ABBREV[SYS,BGB]" SOURCE_FILE;
00300 ITG R,C,QQ,COL,PTR;
00400 SAFE ITG ARRAY Q[0:1000];
00500 SAFE ITG ARRAY X[0:7,0:63];
00600
00700 SUBR OSTR(STRING S);⊂ OUTSTR(S);OUT(2,S);⊃;
00800
00900 SUBR PROW(ITG I);
01000 BEGIN
01100 ITG J,K;
01200 FOR J←0 STEP 8 UNTIL 48 DO ⊂ OSTR(" ");
01300 FOR K←0 TO 7 DO ⊂ IF K=4∨K=2∨K=6 THEN OSTR(" ");
01400 IF X[I,J+K] THEN OSTR("Q") ELSE OSTR(".");⊃;⊃;
01500 OSTR(↓);
01600 END;
01700
01800 SUBR PRINTX;
01900 BEGIN
02000 ITG I;
02100 FOR I←0 TO 7 DO PROW(I);
02200 OSTR(↓&↓&↓);
02300 X[0,0]←0;ARRBLT(X[0,1],X[0,0],64*8-1);
02400 END;
02500
02600 OPEN(1,"DSK",8,3,0,0,0,0);
02700 LOOKUP(1,"QFILE",0);
02800 ARRYIN(1,Q[0],999);
02900 RELEASE(1);
03000
03100 OPEN(2,"DSK",0,0,3,0,0,0);
03200 ENTER(2,"Q.LST",0);
00100 FOR PTR←1 TO 56 DO
00200 BEGIN
00300 QQ ← Q[PTR];
00400 R←(QQ LAND '70)LSH -3;C←QQ LAND '7;QQ←QQ LSH -6;X[R,C+COL]←-1;
00500 R←(QQ LAND '70)LSH -3;C←QQ LAND '7;QQ←QQ LSH -6;X[R,C+COL]←-1;
00600 R←(QQ LAND '70)LSH -3;C←QQ LAND '7;QQ←QQ LSH -6;X[R,C+COL]←-1;
00700 R←(QQ LAND '70)LSH -3;C←QQ LAND '7;QQ←QQ LSH -6;X[R,C+COL]←-1;
00800 R←(QQ LAND '70)LSH -3;C←QQ LAND '7;QQ←QQ LSH -6;X[R,C+COL]←-1;
00900 COL←COL+8;
01000 IF COL=56 THEN
01100 BEGIN COL←0;PRINTX;END;
01200
01300 END;
01500 RELEASE(2);
01600
01700 END;